Languguage OS 2/Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO/language/embedded/mcu/float09.arc/INTFLT.SA

Text File | 1987-03-04 | 11KB | 534 lines

 NAM INTFLT
 TTL  FLOATING TO BINARY INTEGER CONVERSION
*
* LINKING LOADER DEFINITIONS
*
 XDEF GETINT,BIGINT,FFIX,FIXNAN,FLOAT,FIXZER
 XDEF  GOSET
*
 XREF ROUND,CLRES,SNORM,LNORM,PREC,ENORM,MOVE
 XREF  ZERO,IOPSUB,RTZERO,FPMOVE,FILSKY,DENORM
 XREF  TFRACT
*
* REVISION HISTORY:
*   DATE    PROGRAMMER     REASON
*
*  23.MAY.80    GREG STEVENS     ORIGINAL CREATION
*  12.JUN.80    G.STEVENS     FIX & OPT. INTEGER
*  04.AUG.80    G. STEVENS     FIX ALL INVOKATIONS OF ROUND
*  06.AUG.80    G. STEVENS     FIX FFIX FOR ZERO AND CCREG
*  07.AUG.80    G. STEVENS     ADD FIXZER & FIX FIXNAN
*  11.AUG.80    G. STEVENS     CHANGE FIXNAN
*  13.AUG.80    G. STEVENS     ADD UTILITY HOOKS IN INTEGER
*  08.OCT.80    G. STEVENS     "GETINT" NOW IGNORES UNNRM ZEROS
*  09.OCT.80    G. STEVENS     "GETINT" INVOKES FPMOVE VS MOVE
*
 PAG
*******************************************************************
*
*  HERE IS THE FUNCTION FCFIX WHICH TAKES A
* F.P. NUMBER AND CONVERTS IT TO A SIGNED BINARY
* INTEGER.
*
*
* PROCEDURE FFIX
*
*  FFIX CONVERTS A F.P. VALUE TO A BINARY INTEGER
* THE RESULT CAN BE EITHER A 16 OR 32 BIT SIGNED
* VALUE. IF THE RESULT OF THE CONVERSION WILL NOT
* FIT INTO THE DESTINATION THEN THE LARGEST INTEGER
* IS RETURNED.
*
*
*
FFIX EQU  *
*
* GET THE INTEGER PART OF THE FLOATING OPERAND
*
 LBSR  GETINT
*
* CONVERT INTEGER PART TO A BINARY INTEGER
*
 LDA  FUNCT,U
 IF  A,EQ,#FCFIXS
   LEAX  SINTSZ,PCR
*
 ELSE
   LEAX  DINTSZ,PCR
*
 ENDIF
*
* IF THE ARGUMENT HAS NO INTEGER PART JUST RETURN
* ZERO AS THE  BINARY INTEGER.
*
 LDD  EXPR,U
 IF  D,LT,#0           NO INTEGER PART
   MOVD  #0,(FRACTR,U)
   MOVD  #0,(FRACTR+2,U)
*
   LDA    CCREG,U        SET Z BIT IN CCREG
   ORA    #Z
   ANDA  #($FF-(N+V+C))
   STA    CCREG,U
*
 ELSE
*
* IF THE EXPONENT OF THE ARGUMENT IS LARGER
* THAN THE INTEGER SIZE IN BITS THEN RETURN
* THE LARGEST POSSIBLE INTEGER OF THE CORRECT
* CORRECT SIZE.
*
   IF  D,GE,(0,X)    EXPONENT TOO BIG
     BSR  BIGINT
*
* ELSE IF THE EXPONENT IS SUCH THAT THE INTEGER
* WILL FIT INTO THE DESIRED DESTINATION THEN
* RIGHT SHIFT THE EXPONENT UP AGAINST THE
* PROPER BYTE BOUNDARY.
*
   ELSE          EXPONENT 0 K
     LEAY  FRACTR,U
     WHILE  D,LT,(0,X)
       ANDCC  #NC     CLEAR CARRY
       RSHIFT  0,Y,4
       INCD
*
     ENDWH
     LDA  CCREG,U      CLEAR BITS IN CCREG
     ANDA  #($FF-(N+C+V+Z))
*
* NOW CHECK THE SIGN OF THE ARGUMENT AND POSSIBLY
* TAKE THE TWO'S COMPLEMENT OF THE RESULT SINCE
* ORIGINALLY THINGS WERE SIGN AND MAGNITUDE.
*
     LDB  ARG2,U
     IFCC  LT         SIGN NEGATIVE
     COM  0,Y
     COM  1,Y
     COM  2,Y
     NEG  3,Y
     BCS  OUTFIX
     INC  2,Y
     BNE  OUTFIX
     INC  1,Y
     BNE  OUTFIX
     INC  0,Y
*
*
OUTFIX     EQU  *
*
     ORA  #N     SET N BIT IN CCREG
*
     ENDIF         SIGN NEGATIVE
     STA  CCREG,U      REPLACE CCREG
*
   ENDIF    EXPONENT TOO LARGE
*
 ENDIF              NO INTEGER PART
*
*
 RTS         RETURN
*
* SIZE TABLE
*
SINTSZ FDB  15
DINTSZ FDB  31
*
*
 PAG
*
*
*******************************************************************
*
* PROCEDURE  BIGINT
*
*   BIGINT HANDLES A FFIX, FLOATING TO BINARY INTEGER
* CONVERSION WHEN THE ARGUMENT IS INFINITY OR THE
* PASSED F.P. VALUE IS TO BIG TO FIT INTO THE DESTINATION.
* THE INTEGER IS SET AS BELOW.
*
*      SHORT POSITIVE     32767
*      SHORT NEGATIVE    -32768
*      LONG POSITIVE    2,147,483,647
*      LONG NEGATIVE   -2,147,483,648
*
*
*    ON ENTRY: U IS THE STACK FRAME POINTER
*
*    ON EXIT: FIRST TWO OR FOUR BYTES OF THE FRACTION
*          CONTAIN THE BINARY INTEGER.
*
*
BIGINT EQU  *
*
* CHECK THE SIGN OF THE ARGUMENT TO SEE WHETHER TO
* RETURN A LARGE POSITIVE OR LARGE NEGATIVE NUMBER.
*
 LDB  CCREG,U         PREPARE TO SET CCREG PROPERLY
 ANDB  #($FF-(N+C+Z))
 ORB  #V
 STB  CCREG,U
*
 LDA  ARG2,U        CHECK SIGN
 IFCC  GE        SIGN POSITIVE
   MOVD  (LPINT,PCR),(FRACTR,U)
*
   MOVD   (LPINT+2,PCR),(FRACTR+2,U)
*
* ELSE IF SIGN NEGATIVE RETURN A LARGE NEGATIVE NUMBER
*
 ELSE            SIGN NEGATIVE
   LDB    CCREG,U
   ORB    #N
   STB    CCREG,U
   MOVD  (LNINT,PCR),(FRACTR,U)
*
   MOVD  (LNINT+2,PCR),(FRACTR+2,U)
*
 ENDIF            SIGN POSITIVE
*
* SET INTEGER OVERFLOW BIT IN MAIN STATUS
*
 LDA  TSTAT,U
 ORA  #ERRIOV
 STA  TSTAT,U
*
*
 RTS      RETURN
*
* INREGER CONSTANTS
*
LPINT FDB  $7FFF,$FFFF
LNINT FDB  $8000,0000
*
*
 PAG
*
*
*******************************************************************
*
* PROCEDURE  FIXNAN
*
*    FIXNAN HANDLES A FFIX, FLOATING TO BINARY INTEGER
* CONVERSION WHEN THE ARGHUMENT IS A NAN. INVALID
* OPERATION (IOP = 3) IS SIGNALED AND THE NAN
* ADDRESS IS RETURNED IN THE PLACE OF THE INTEGER.
*
*  ON ENTRY: U IS THE STACK FRAME POINTER
*
*  ON EXIT: THE FIRST TWO BYTES OF THE FRACTION CONTAIN
*       THE NAN ADDRESS.
*
*
FIXNAN EQU  *
*
*
* SIGNAL INVALIS OPERATION (IOP = 3)
*
 LDD  #(256*ERRIOP)+3     IOP CODE & IOP FLAG
 STD  TSTAT,U         SECONDARY STATUS
*
* RETURN THE NAN ADDRESS
*
 LEAX  ARG2,U        SOURCE
 LEAY  RESULT,U     DESTINATION
 LBSR  FPMOVE
 ANDCC    #NC        CLEAR CARRY
 LSHIFT  FRACT,Y,3    SHIFT ADDRESS TO NEAREST BYTE BOUNDARY
 LSHIFT  FRACT,Y,3
*
*
* RETURN CCREG WITH C BIT SET
*
 LDA  CCREG,U
 ANDA  #($FF-(N+V+Z))
 ORA  #C
 STA  CCREG,U
*
*
 RTS            RETURN
*
*
 PAGE
*
**************************************************************
*
* PROCEDURE FIXZER
*
*     HANDLES FIXES WHERE THE INPUT ARGUMENT IS ZERO
*
*  ON ENTRY: ARG2 CONTAINS THE INPUT ARGUMENT
*         U - STACK FRAME POINTER
*
*  ON EXIT: RESULT CONTAINS THE RESULT
*        U,S - UCHANGED
*        X,Y,D,CC - DESTROYED
*
FIXZER EQU  *
*
* SET Z BIT IN CCREG
*
  LDA  CCREG,U
  ANDA    #($FF-(N+V+C))
  ORA  #Z        SET Z BIT
  STA  CCREG,U
*
* RETURN A ZERO
*
  LBSR    RTZERO
*
  RTS              RETURN
*
 PAGE
*
******************************************************************
*
* PROCEDURE INTEGER
*
*    INTEGER TAKES THE FLOATING OPERAND RESIDING
* IN ARG2  AND RETURN THE INTEGER PART AS  IT'S
* RESULT
*
* ON ENTRY: ARG2 CONTAINS THE INPUT ARGUMENT
*        U - STACK FRAME POINTER
*
* ON EXIT: STACK FRAME RESULT CONTAINS THE INTEGER PART
*       U - UNCHANGED
*       X,Y,A,B,CC - DESTROYED
*
*
*
* LOCAL EQUATES
*
LOWBND    EQU  -2
*
GETINT EQU  *
*
* FIRST MOVE THE ARGUMENT TO THE RESULT
*
 LEAX  ARG2,U      SOURCE
 LEAY  RESULT,U   DESTINATION
*
 LBSR  FPMOVE
*
* CHECK FOR AN UNNORMAL ZERO AND IF THIS IS THE
* CASE JUST RETURN THE ARGUMENT AS IS
*
  LBSR    TFRACT
  IFCC    EQ         FRACTION IS ZERO
    BRA  EXINT         ESCAPE INTEGER ROUTINE
*
  ENDIF
*
* FIND PRECISION OF THE OPERAND
*
 LDB  RPREC,U      GET THE PRECISION INDEX
 PSHS  B     SAVE PRECISION ON THE STACK
*
* IF THE EXPONENT IS LARGE ENOUGH SO THAT NO FRACTION
* PART EXITS THEN JUST RETURN THE INPUT ARGUMENT AS IS
*
 LEAX  SIGSIZ,PCR   SIGNIFICAND LENGTH TABLE
 ABX
 LDD  EXPR,U
 IF  D,LT,(0,X)    EXPONENT BELOW UPPER BOUND
*
* IF THE EXPONENT IS BELOW THE LOWER BOUND THEN JUST
* OR ALL THE FRACTION BYTES INTO THE STIKY BYTE AND
* ZERO OUT THE FRACTION.
*
   IF  D,LE,#LOWBND     EXPONENT BELOW LOWER BOUND
     CLR  STIKY,U      INITIALIZE STIKY BYTE
     LEAX  RESULT,U
     LBSR  FILSKY         FILL STICKY
*
* NOW UPDATE EXPONENT WITH CORRECT VALUE
*
     LDB  0,S
     LEAX  SIGSIZ,PCR
     MOVD  (B,X),(EXPR,U)
*
     MOVD  (#00),(EXP2,U)
*
* ELSE IF THE EXPONENT WITHIN THE UPPER AND LOWER
* BOUNDS THEN RIGHT SHIFT THE SGNIFICAND WHILE
* INCREMENTING THE EXPONENT WHILE ADDITIONALLY
* ORING INTO THE STIKY BYTE THE BITS THAT FALL
* OFF THE END OF THE STACK FRAME ARGUMENT.
*
   ELSE          EXPONENT WITHIN BOUNDS
*
* NOW UPDATE EXPONENT WITH CORRECT VALUE
*
     LEAX  SIGSIZ,PCR
     LDB  0,S           PRECISION INDEX
     MOVD  (B,X),(EXPR,U)  MOVE EXPONENT
*
     SUBD  EXP2,U    CALCULATES # OF SHIFTS TO DO
     CLR  STIKY,U        INITIALIZE STIKY BYTE
     LEAX  RESULT,U
     LBSR  DENORM        DENORMALIZE RESULT
*
*
   ENDIF      EXPONENT BELOW LOWER BOUND
*
* ROUND THAT FRACTIONAL PART OF SIGNIFICAND LIES
* WITHIN ROUNDING PRECISION
*
   LEAX  RESULT,U
   LBSR  ROUND
*
* NOW NORMALIZE THE RESULT AGAIN
*
* IF THE ARGUMENT WAS ORIGINALLY NORMALIZED THEN
* THEN NORMALIZE AS USUAL
*
   LDA    FRACT2,U    LOOK AT ORIGINAL ARGUMENT
   IFCC  LT        ORIGINALLY NORMALIZED
     LBSR  LNORM
*
* ELSE IF THE ARGUMENT WAS ORIGINALLY UNORMALIZED
* THEN ONLY SHIFT THE SIGNIFICAND UNTIL IT REFLECTS
* THE ORIGINAL PRECISION, I.E. EXPONENT SAME AS BEFORE
*
   ELSE       ORIGINALLY UNORMALIZED
     LDY  EXP2,U  USE ORIGINAL EXP. AS REFERENCE
     LBSR  ENORM
*
   ENDIF      ORIGINALLY NORMALIZED
*
 ENDIF        EXPONENT ABOVE UPPER BOUND
*
 LEAS  1,S       CLEAN UP STACK
*
EXINT  EQU  *
*
 RTS        RETURN
*
*
* SIGNIFICAND SIZE TABLE
*
SIGSIZ FDB  23
       FDB  52
       FDB  63
       FDB  23
       FDB  52
*
* G-BYTE OFFSET TABLE
*
GOSET FCB  3   SINGLE
      FCB  6    DOUBLE
      FCB  8    EXTENDED
      FCB  3   SINGLE
      FCB  6   EXT. FORCE TO DOUBLE
*
*
*
*******************************************************************
*
 TTL INTEGER TO FLOATING CONVERSION
*
***************************************************************
*
* PROCEDURE FLOAT
*    FLOAT CONVERTS A BINARY INTEGER TO A FLOATING
* REPRESENTATION. THE INPUT ARGUMENT CAN EIHTER BE
* A 16 OR 32 BIT SIGNED INTEGER. IF THE ARGUMENT
* IS 32 BIT LONG AND THE DESTINATION IS SINGLE
* THEN THE VALUE IS ROUNDED ONCE.
*
*  ON ENTRY:
*     U IS A STACK FRAME POINTER
*
*  ON EXIT:
*     RESULT CONTAINS A FLOATING VALUE REPRESENTING
*     THE BINARY INTEGER.
*
FLOAT EQU  *
*
 LEAX  RESULT,U
 LDB  #ARGSIZ-1
 WHILE    B,GE,#00
   CLR    B,X
   DECB
*
 ENDWH
*
* SET EXPONENT TO PROPER VALUE
*
 LDA  FUNCT,U               CHECK FUNCTION
 IF  A,EQ,#FCFLTS           SINGLE PRECISION FLOAT
   LEAY  SINTSZ,PCR
*
 ELSE
   LEAY  DINTSZ,PCR           DOUBLE PRECISION FLOAT
*
 ENDIF
*
* MOVE INTEGER TO RESULT
*
 MOVD  (0,Y),(EXPR,U)
*
 MOVD  (FRACT2,U),(FRACTR,U)
 MOVD  (FRACT2+2,U),(FRACTR+2,U)
*
* CHECK SIGN OF INTEGER AND NEGATE THE INTEGER
* IF NECESSARY.
*
 LDA  FRACTR,U
 IFCC  LT              SIGN NEGATIVE
   LDA    #$80              SET SIGN NEGATIVE
   STA    RESULT,U
*
   LEAX  FRACTR,U
     COM  0,X
     COM  1,X
     COM  2,X
     NEG  3,X
     BCS  OUTFLT
     INC  2,X
     BNE  OUTFLT
     INC  1,X
     BNE  OUTFLT
     INC  0,X
*
*
OUTFLT EQU  *
*
 ENDIF            INTEGER NEGATIVE
*
* NORMALIZE RESULT
*
 LEAX  RESULT,U
*
 LBSR  SNORM
*
* IF THE ARGUMENT WAS 32 BITS LONG AND THE PRECISION
* IS SINGLE, THEN ROUND THE RESULT TO YIELD EXACT
* REPRESENTATION
*
 LDA  FUNCT,U
 IF  A,EQ,#FCFLTD        DOUBLE PRECISION FLOAT
   LDA    RPREC,U        PRECISION RESULT
   IF  A,EQ,#SIN       SINGLE PRECISION
     BRA  RND
*
   ELSE
   IF A,EQ,#EFS         FORCE TO SINGLE:
*
RND EQU  *
*
     STA  STIKY,U         SET STIKY BYTE
*
     LBSR  ROUND         ROUND RESULT
*
   ENDIF
   ENDIF             SINGLE PRECISION
*
 ENDIF                DOUBLE PRECISION FLOAT
*
*
 RTS      RETURN
*
*